home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap11 / howto05 / ccwsock.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-02-27  |  61.9 KB  |  1,476 lines
  1. unit Ccwsock;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs;
  8. const
  9.   { This is the base message used by Winsock to notify of Winsock asynch act }
  10.   WM_ASYNCSELECT = WM_USER + 0;
  11.   { These are miscellaneous constants which might be needed by an app }
  12.   FD_SETSIZE                   = 64;        { ??? }
  13.   INADDR_ANY                   = $00000000;
  14.   INADDR_LOOPBACK              = $7F000001;
  15.   INADDR_BROADCAST             = $FFFFFFFF;
  16.   INADDR_NONE                  = $FFFFFFFF;
  17.   WSADESCRIPTION_LEN           = 256;       { Winsock defined vendor desc }
  18.   WSASYS_STATUS_LEN            = 128;       { Winsock defined status info }
  19.   { These are IP Protocols Standard values from Winsock ( more or less ) }
  20.   IPPROTO_IP         =  0;              { dummy for IP }
  21.   IPPROTO_ICMP       =  1;              { control message protocol }
  22.   IPPROTO_GGP        =  2;              { gateway^2 (deprecated) }
  23.   IPPROTO_TCP        =  6;              { tcp }
  24.   IPPROTO_PUP        =  12;             { pup }
  25.   IPPROTO_UDP        =  17;             { user datagram protocol }
  26.   IPPROTO_IDP        =  22;             { xns idp }
  27.   IPPROTO_ND         =  77;             { UNOFFICIAL net disk proto }
  28.   IPPROTO_RAW        = 255;             { raw IP packet }
  29.   IPPROTO_MAX        = 256;
  30.   { These are "well known" Port/socket numbers for client functions }
  31.   IPPORT_ECHO        =     7;
  32.   IPPORT_DISCARD     =     9;
  33.   IPPORT_SYSTAT      =     11;
  34.   IPPORT_DAYTIME     =     13;
  35.   IPPORT_NETSTAT     =     15;
  36.   IPPORT_FTP         =     21;  { FTP Default }
  37.   IPPORT_TELNET      =     23;  { Telnet Default }
  38.   IPPORT_SMTP        =     25;  { SMTP Default }
  39.   IPPORT_TIMESERVER  =     37;
  40.   IPPORT_NAMESERVER  =     42;
  41.   IPPORT_WHOIS       =     43;
  42.   IPPORT_MTP         =     57;
  43.   { These are "well known" Port/socket numbers for host specific functions }
  44.   IPPORT_TFTP        =     69;
  45.   IPPORT_RJE         =     77;
  46.   IPPORT_FINGER      =     79; { Finger Default }
  47.   IPPORT_TTYLINK     =     87;
  48.   IPPORT_SUPDUP      =     95;
  49.   { These are "well known" UNIX TCP sockets }
  50.   IPPORT_EXECSERVER  =     512;
  51.   IPPORT_LOGINSERVER =     513;
  52.   IPPORT_CMDSERVER   =     514;
  53.   IPPORT_EFSSERVER   =     520;
  54.   { These are "well known" UNIX UDP sockets }
  55.   IPPORT_BIFFUDP     =     512;
  56.   IPPORT_WHOSERVER   =     513;
  57.   IPPORT_ROUTESERVER =     520;
  58.   { Reserved Port number base }
  59.   IPPORT_RESERVED    =     1024;
  60.   { Link numbers (Which I don't know what are, either... :) }
  61.   IMPLINK_IP         =     155;
  62.   IMPLINK_LOWEXPER   =     156;
  63.   IMPLINK_HIGHEXPER  =     158;
  64.   { Winsock constants }
  65.   INVALID_SOCKET     =     $ffff;
  66.   SOCKET_ERROR       =     (-1);
  67.   { Socket Types; STREAM is the only one normally used }
  68.   SOCK_STREAM        =  1;              { stream socket }
  69.   SOCK_DGRAM         =  2;              { datagram socket }
  70.   SOCK_RAW           =  3;              { raw-protocol interface }
  71.   SOCK_RDM           =  4;              { reliably-delivered message }
  72.   SOCK_SEQPACKET     =  5;              { sequenced packet stream }
  73.   { Individual Socket Option flags }
  74.   SO_DEBUG           =  $0001;         { turn on debugging info recording }
  75.   SO_ACCEPTCONN      =  $0002;         { socket has had listen() }
  76.   SO_REUSEADDR       =  $0004;         { allow local address reuse }
  77.   SO_KEEPALIVE       =  $0008;         { keep connections alive }
  78.   SO_DONTROUTE       =  $0010;         { just use interface addresses }
  79.   SO_BROADCAST       =  $0020;         { permit sending of broadcast msgs }
  80.   SO_USELOOPBACK     =  $0040;         { bypass hardware when possible }
  81.   SO_LINGER          =  $0080;         { linger on close if data present }
  82.   SO_OOBINLINE       =  $0100;         { leave received OOB data in line }
  83.   SO_DONTLINGER      = (not SO_LINGER);
  84.   SO_SNDBUF          =  $1001;         { send buffer size }
  85.   SO_RCVBUF          =  $1002;         { receive buffer size }
  86.   SO_SNDLOWAT        =  $1003;         { send low-water mark }
  87.   SO_RCVLOWAT        =  $1004;         { receive low-water mark }
  88.   SO_SNDTIMEO        =  $1005;         { send timeout }
  89.   SO_RCVTIMEO        =  $1006;         { receive timeout }
  90.   SO_ERROR           =  $1007;         { get error status and clear }
  91.   SO_TYPE            =  $1008;         { get socket type }
  92.   { TCP global options }
  93.   TCP_NODELAY        =  $0001;
  94.   { IP Address families }
  95.   AF_UNSPEC          =  0;              { unspecified }
  96.   AF_UNIX            =  1;              { local to host (pipes, portals) }
  97.   AF_INET            =  2;              { internetwork: UDP, TCP, etc. }
  98.   AF_IMPLINK         =  3;              { arpanet imp addresses }
  99.   AF_PUP             =  4;              { pup protocols: e.g. BSP }
  100.   AF_CHAOS           =  5;              { mit CHAOS protocols }
  101.   AF_NS              =  6;              { XEROX NS protocols }
  102.   AF_ISO             =  7;              { ISO protocols }
  103.   AF_OSI             =  AF_ISO;         { OSI is ISO }
  104.   AF_ECMA            =  8;              { european computer manufacturers }
  105.   AF_DATAKIT         =  9;              { datakit protocols }
  106.   AF_CCITT           =  10;             { CCITT protocols, X.25 etc }
  107.   AF_SNA             =  11;             { IBM SNA }
  108.   AF_DECnet          =  12;             { DECnet }
  109.   AF_DLI             =  13;             { Direct data link interface }
  110.   AF_LAT             =  14;             { LAT }
  111.   AF_HYLINK          =  15;             { NSC Hyperchannel }
  112.   AF_APPLETALK       =  16;             { AppleTalk }
  113.   AF_NETBIOS         =  17;             { NetBios-style addresses }
  114.   AF_MAX             =  18;
  115.   { IP Protocol families, same as address families for now }
  116.   PF_UNSPEC          =  AF_UNSPEC;
  117.   PF_UNIX            =  AF_UNIX;
  118.   PF_INET            =  AF_INET;
  119.   PF_IMPLINK         =  AF_IMPLINK;
  120.   PF_PUP             =  AF_PUP;
  121.   PF_CHAOS           =  AF_CHAOS;
  122.   PF_NS              =  AF_NS;
  123.   PF_ISO             =  AF_ISO;
  124.   PF_OSI             =  AF_OSI;
  125.   PF_ECMA            =  AF_ECMA;
  126.   PF_DATAKIT         =  AF_DATAKIT;
  127.   PF_CCITT           =  AF_CCITT;
  128.   PF_SNA             =  AF_SNA;
  129.   PF_DECnet          =  AF_DECnet;
  130.   PF_DLI             =  AF_DLI;
  131.   PF_LAT             =  AF_LAT;
  132.   PF_HYLINK          =  AF_HYLINK;
  133.   PF_APPLETALK       =  AF_APPLETALK;
  134.   PF_MAX             =  AF_MAX;
  135.  { Level number for (get/set)sockopt() to apply to socket itself }
  136.  SOL_SOCKET          = -1;          { options for socket level }
  137.  { Maximum queue length specifiable by listen }
  138.  SOMAXCONN     =   5;
  139.  MSG_OOB       =  $1;             { process out-of-band data }
  140.  MSG_PEEK      =  $2;             { peek at incoming message }
  141.  MSG_DONTROUTE =  $4;             { send without using routing tables }
  142.  MSG_MAXIOVLEN =  16;
  143.  { Define constant based on rfc883, used by gethostbyxxxx() calls }
  144.  MAXGETHOSTSTRUCT   =     1024;
  145.  { Define flags to be used with the WSAAsyncSelect() call }
  146.  FD_READ       =  $01;
  147.  FD_WRITE      =  $02;
  148.  FD_OOB        =  $04;
  149.  FD_ACCEPT     =  $08;
  150.  FD_CONNECT    =  $10;
  151.  FD_CLOSE      =  $20;
  152.  { All Windows Sockets error constants are biased by WSABASEERR from the norm }
  153.  WSABASEERR    =          10000;
  154.  { Windows Sockets definitions of regular Microsoft C error constants }
  155.  WSAEINTR      =          (WSABASEERR+4);
  156.  WSAEBADF      =          (WSABASEERR+9);
  157.  WSAEACCES     =          (WSABASEERR+13);
  158.  WSAEFAULT     =          (WSABASEERR+14);
  159.  WSAEINVAL     =          (WSABASEERR+22);
  160.  WSAEMFILE     =          (WSABASEERR+24);
  161.  { Windows Sockets definitions of regular Berkeley error constants }
  162.  WSAEWOULDBLOCK      =    (WSABASEERR+35);
  163.  WSAEINPROGRESS      =    (WSABASEERR+36);
  164.  WSAEALREADY         =    (WSABASEERR+37);
  165.  WSAENOTSOCK         =    (WSABASEERR+38);
  166.  WSAEDESTADDRREQ     =    (WSABASEERR+39);
  167.  WSAEMSGSIZE         =    (WSABASEERR+40);
  168.  WSAEPROTOTYPE       =    (WSABASEERR+41);
  169.  WSAENOPROTOOPT      =    (WSABASEERR+42);
  170.  WSAEPROTONOSUPPORT  =    (WSABASEERR+43);
  171.  WSAESOCKTNOSUPPORT  =    (WSABASEERR+44);
  172.  WSAEOPNOTSUPP       =    (WSABASEERR+45);
  173.  WSAEPFNOSUPPORT     =    (WSABASEERR+46);
  174.  WSAEAFNOSUPPORT     =    (WSABASEERR+47);
  175.  WSAEADDRINUSE       =    (WSABASEERR+48);
  176.  WSAEADDRNOTAVAIL    =    (WSABASEERR+49);
  177.  WSAENETDOWN         =    (WSABASEERR+50);
  178.  WSAENETUNREACH      =    (WSABASEERR+51);
  179.  WSAENETRESET        =    (WSABASEERR+52);
  180.  WSAECONNABORTED     =    (WSABASEERR+53);
  181.  WSAECONNRESET       =    (WSABASEERR+54);
  182.  WSAENOBUFS          =    (WSABASEERR+55);
  183.  WSAEISCONN          =    (WSABASEERR+56);
  184.  WSAENOTCONN         =    (WSABASEERR+57);
  185.  WSAESHUTDOWN        =    (WSABASEERR+58);
  186.  WSAETOOMANYREFS     =    (WSABASEERR+59);
  187.  WSAETIMEDOUT        =    (WSABASEERR+60);
  188.  WSAECONNREFUSED     =    (WSABASEERR+61);
  189.  WSAELOOP            =    (WSABASEERR+62);
  190.  WSAENAMETOOLONG     =    (WSABASEERR+63);
  191.  WSAEHOSTDOWN        =    (WSABASEERR+64);
  192.  WSAEHOSTUNREACH     =    (WSABASEERR+65);
  193.  WSAENOTEMPTY        =    (WSABASEERR+66);
  194.  WSAEPROCLIM         =    (WSABASEERR+67);
  195.  WSAEUSERS           =    (WSABASEERR+68);
  196.  WSAEDQUOT           =    (WSABASEERR+69);
  197.  WSAESTALE           =    (WSABASEERR+70);
  198.  WSAEREMOTE          =    (WSABASEERR+71);
  199.  { Extended Windows Sockets error constant definitions }
  200.  WSASYSNOTREADY      =    (WSABASEERR+91);
  201.  WSAVERNOTSUPPORTED  =    (WSABASEERR+92);
  202.  WSANOTINITIALISED   =    (WSABASEERR+93);
  203.  { Authoritative Answer: Host not found }
  204.  WSAHOST_NOT_FOUND   =    (WSABASEERR+1001);
  205.  HOST_NOT_FOUND      =    WSAHOST_NOT_FOUND;
  206.  { Non-Authoritative: Host not found, or SERVERFAIL }
  207.  WSATRY_AGAIN        =    (WSABASEERR+1002);
  208.  TRY_AGAIN           =    WSATRY_AGAIN;
  209.  { Non recoverable errors, FORMERR, REFUSED, NOTIMP }
  210.  WSANO_RECOVERY      =    (WSABASEERR+1003);
  211.  NO_RECOVERY         =    WSANO_RECOVERY;
  212.  { Valid name, no data record of requested type }
  213.  WSANO_DATA          =    (WSABASEERR+1004);
  214.  NO_DATA             =    WSANO_DATA;
  215.  { no address, look for MX record }
  216.  WSANO_ADDRESS       =    WSANO_DATA;
  217.  NO_ADDRESS          =    WSANO_ADDRESS;
  218.  { Windows Sockets errors redefined as regular Berkeley error constants }
  219.  EWOULDBLOCK         =    WSAEWOULDBLOCK;
  220.  EINPROGRESS         =    WSAEINPROGRESS;
  221.  EALREADY            =    WSAEALREADY;
  222.  ENOTSOCK            =    WSAENOTSOCK;
  223.  EDESTADDRREQ        =    WSAEDESTADDRREQ;
  224.  EMSGSIZE            =    WSAEMSGSIZE;
  225.  EPROTOTYPE          =    WSAEPROTOTYPE;
  226.  ENOPROTOOPT         =    WSAENOPROTOOPT;
  227.  EPROTONOSUPPORT     =    WSAEPROTONOSUPPORT;
  228.  ESOCKTNOSUPPORT     =    WSAESOCKTNOSUPPORT;
  229.  EOPNOTSUPP          =    WSAEOPNOTSUPP;
  230.  EPFNOSUPPORT        =    WSAEPFNOSUPPORT;
  231.  EAFNOSUPPORT        =    WSAEAFNOSUPPORT;
  232.  EADDRINUSE          =    WSAEADDRINUSE;
  233.  EADDRNOTAVAIL       =    WSAEADDRNOTAVAIL;
  234.  ENETDOWN            =    WSAENETDOWN;
  235.  ENETUNREACH         =    WSAENETUNREACH;
  236.  ENETRESET           =    WSAENETRESET;
  237.  ECONNABORTED        =    WSAECONNABORTED;
  238.  ECONNRESET          =    WSAECONNRESET;
  239.  ENOBUFS             =    WSAENOBUFS;
  240.  EISCONN             =    WSAEISCONN;
  241.  ENOTCONN            =    WSAENOTCONN;
  242.  ESHUTDOWN           =    WSAESHUTDOWN;
  243.  ETOOMANYREFS        =    WSAETOOMANYREFS;
  244.  ETIMEDOUT           =    WSAETIMEDOUT;
  245.  ECONNREFUSED        =    WSAECONNREFUSED;
  246.  ELOOP               =    WSAELOOP;
  247.  ENAMETOOLONG        =    WSAENAMETOOLONG;
  248.  EHOSTDOWN           =    WSAEHOSTDOWN;
  249.  EHOSTUNREACH        =    WSAEHOSTUNREACH;
  250.  ENOTEMPTY           =    WSAENOTEMPTY;
  251.  EPROCLIM            =    WSAEPROCLIM;
  252.  EUSERS              =    WSAEUSERS;
  253.  EDQUOT              =    WSAEDQUOT;
  254.  ESTALE              =    WSAESTALE;
  255.  EREMOTE             =    WSAEREMOTE;
  256.  IOCPARM_MASK = $7f;
  257.  IOC_VOID     = $20000000;
  258.  IOC_OUT      = $40000000;
  259.  IOC_IN       = $80000000;
  260.  IOC_INOUT    = (IOC_IN or IOC_OUT);
  261.  
  262.  FIONREAD     = IOC_OUT or { get # bytes to read }
  263.    ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
  264.    (Longint(Byte('f')) shl 8) or 127;
  265.  FIONBIO      = IOC_IN or { set/clear non-blocking i/o }
  266.    ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
  267.    (Longint(Byte('f')) shl 8) or 126;
  268.  FIOASYNC     = IOC_IN or { set/clear async i/o }
  269.    ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
  270.    (Longint(Byte('f')) shl 8) or 125;
  271.  
  272. type
  273.   u_char = Char;
  274.   u_short = Word;
  275.   u_int = Cardinal;
  276.   u_long = Longint;
  277.  
  278.   { These are type definitions to ease using a C DLL }
  279.   Unsigned_Character     = byte;
  280.   Unsigned_Short_Integer = u_short;
  281.   Unsigned_Integer       = Cardinal;
  282.   Unsigned_Long_Integer  = u_long;
  283.   { We have to do this because a Socket in Winsock is a U_INT }
  284.   TSocket                = Unsigned_Integer;
  285.   { Another C structure from Winsock; originally called "servent"** conv ** }
  286.   Server_Entry = packed record
  287.     Server_Name     : PChar;
  288.     Server_Aliases  : ^PChar; { Note double indirection here; array of PChar }
  289.     Server_Port     : SmallInt;
  290.     Server_Protocol : PChar;
  291.   end;
  292.   PServer_Entry = ^Server_Entry;
  293.   { This C structure was originally called "protoent" *** converted *** }
  294.   Protocol_Entry = packed record
  295.     Protocol_Name    : PChar;
  296.     Protocol_Aliases : ^PChar; { Another array of PChar }
  297.     Protocol_Id      : SmallInt;
  298.   end;
  299.   PProtocol_Entry = ^Protocol_Entry;
  300.   { This is a clever variant record useful for casting internet addresses }
  301.   { originally called TInAddr *** converted *** }
  302.   Internet_Address = packed record
  303.     Case Integer of
  304.     0: ( Net_Byte              ,
  305.          Host_Byte             ,
  306.          Local_Host_Byte       ,
  307.          Local_Machine_Byte      : Unsigned_Character );
  308.     1: ( Network_Portion       ,
  309.          Local_Machine_Portion   : Unsigned_Short_Integer );
  310.     2: ( Full_Internet_Address   : Unsigned_Long_Integer );
  311.   end;
  312.   PInternet_address = ^Internet_Address;
  313.   { This structure was originally known as "sockaddr_in" **converted**}
  314.   Internet_Socket_Address = packed record
  315.     case Integer of
  316.      0 : (Socket_Family        : u_short;
  317.           Socket_Port          : Unsigned_Short_Integer;
  318.           Socket_Address       : Internet_Address;
  319.           Socket_Padding_Array : array[ 0 .. 7 ] of char );
  320.      1 : (A_Socket_family        : u_short;
  321.           Socket_Data          : array[ 0 .. 13 ] of Char )
  322.   end;
  323.   PInternet_Socket_Address = ^Internet_Socket_Address;
  324.   { This structure's C name is "hostent" **** converted ****}
  325.   Host_Entry = packed record
  326.     Host_Name              : PChar;
  327.     Host_Aliases           : ^PChar;
  328.     Host_Address_Type      : smallint;
  329.     Host_Address_Length    : smallint;
  330.     Case Integer of        { Another useful variant record    }
  331.     0: ( host_address_list : ^PChar ); { Double pointer again }
  332.     1: ( host_address      : ^PInternet_address );
  333.   end;
  334.   PHost_entry = ^Host_Entry;
  335.   { This is usually called WSADATA **converted**}
  336.   Winsock_Implementation_Data = packed record
  337.     Winsock_Version           : word;
  338.     Winsock_High_Version      : word;
  339.     { Note these two arrays are based on global constants for size }
  340.     Description_String        : array[ 0 .. WSADESCRIPTION_LEN ] of char;
  341.     System_Status_String      : array[ 0 .. WSASYS_STATUS_LEN ] of char;
  342.     Maximum_Sockets_Allowed   : Unsigned_Short_Integer;
  343.     Maximum_UDP_Datagram_Size : Unsigned_Short_Integer;
  344.     Vendor_Specific_String    : PChar;
  345.   end;
  346.   { This is usually known as "sockaddr" **converted**}
  347.   Generic_Socket_Address = Internet_Socket_Address;
  348.   { This in C is "sockproto" }
  349.   Socket_Protocol = packed record
  350.     Protocol_Family : Unsigned_Short_Integer;
  351.     Protocol_Id     : Unsigned_Short_Integer;
  352.   end;
  353.   { This is sometimes called the "linger" structure; used only at shutdown }
  354.   Lingering_Control = packed record
  355.     Linger_Status   : Unsigned_Short_Integer;
  356.     Linger_Interval : Unsigned_Short_Integer;
  357.   end;
  358.   { These two event data types are used to hook into the Winsock Asynch system }
  359.   TWSAEvent = procedure( Sender : TObject; Socket : TSocket ) of object;
  360.   TWSAError = procedure( Sender     : TObject;
  361.                          ErrorCode  : Integer;
  362.                          TheMessage : String ) of object;
  363.   { This is an OOP wrapper around the Winsock calls; tries to buffer a bit }
  364.   TCCSocket = class( TWinControl )
  365.   public
  366.     Socket_WSA_Data       : Winsock_Implementation_Data;
  367.     ErrorCode           : Integer;
  368.     FullErrorMessage    : string;
  369.     WinsockErrorMessage : string;
  370.     Socket_Server_Entry   : PServer_Entry;
  371.     Socket_Host_Entry     : Phost_entry;
  372.     Socket_Protocol_Entry : PProtocol_Entry;
  373.     Socket_IP_Address     : Internet_Socket_Address;
  374.     FPort_Name            : String;
  375.     FIP_Address_Name      : String;
  376.     FSocket               : TSocket;
  377.     FMasterSocket         : TSocket;
  378.     FBlockingMode         : Boolean;
  379.     FTimeoutValue         : Integer;
  380.     FOnDataIsAvailable    : TWSAEvent;
  381.     FOnDataCanBeSent      : TWSAEvent;
  382.     FOnOOBDataIsAvailable : TWSAEvent;
  383.     FOnSessionClosed      : TWSAEvent;
  384.     FOnSessionIsAvailable : TWSAEvent;
  385.     FOnSessionConnected   : TWSAEvent;
  386.     FOnErrorOccurred      : TWSAError;
  387.     procedure SetStringData( TheData: string );
  388.     function GetStringData          : string;
  389.     procedure SetStringDataOutOfBand( TheData: string );
  390.     function GetStringDataOutOfBand : string;
  391.     function PeekCurrentData        : string;
  392.     function GetSocketErrorDescription( ErrorCode : Integer) : string;
  393.     procedure SetSocketErrorData( SocketFunction : string );
  394.     procedure TWMPaint( var Msg : TWMPaint ); message WM_PAINT;
  395.     procedure ActivateNonAsynchTimeout;
  396.     procedure DeactivateNonAsynchTimeout;
  397.     procedure WMASyncSelect( var Msg : TMessage ); message WM_ASYNCSELECT;
  398.     procedure WMTimer( var Msg : TMessage ); message WM_TIMER;
  399.     constructor Create( AOwner : TComponent ); override;
  400.     destructor Destroy; override;
  401.     procedure CCSockConnect;
  402.     procedure CCSockClose;
  403.     procedure CCSockListen;
  404.     procedure CCSockCancelListen;
  405.     function CCSockReceive(     TheSocket     : TSocket;
  406.                                 TheTextBuffer : PChar;
  407.                             var TheTextLength : Integer
  408.                           ) : Integer;
  409.     function CCSockSend(    TheSocket     : TSocket;
  410.                             TheTextBuffer : PChar;
  411.                         var TheTextLength : Integer
  412.                        ) : Integer;
  413.     function CCSockAccept                                  : TSocket;
  414.     function GetSocketIPAddress( TheSocket: TSocket )      : string;
  415.     function GetSocketPort( TheSocket : TSocket )          : string;
  416.     function GetSocketPeerIPAddress( TheSocket : TSocket ) : string;
  417.     function GetSocketPeerPort( TheSocket : TSocket )      : string;
  418.     function SocketIsNotBlocking                           : Boolean;
  419.     procedure ActivateBlockingMode( BeginBlocking : Boolean );
  420.     property StringData      : string
  421.      read GetStringData write SetStringData;
  422.     property PeekData        : string
  423.      read PeekCurrentData;
  424.     property OutOfBand       : string
  425.      read GetStringDataOutOfBand write SetStringDataOutOfBand;
  426.     property TheSocket       : TSocket
  427.      read FSocket write FSocket;
  428.     property TheMasterSocket : TSocket
  429.      read FMasterSocket write FMasterSocket;
  430.   published
  431.     property IPAddressName        : string
  432.      read FIP_Address_Name write FIP_Address_Name;
  433.     property PortName             : string
  434.      read FPort_Name write FPort_Name;
  435.     property AsynchMode           : Boolean
  436.      read SocketIsNotBlocking write ActivateBlockingMode default True;
  437.     property NonAsynchTimeoutValue   : Integer
  438.      read FTimeoutValue write FTimeoutValue default 30;
  439.     property OnDataIsAvailable    : TWSAEvent
  440.      read FOnDataIsAvailable write FOnDataIsAvailable;
  441.     property OnOOBDataIsAvailable    : TWSAEvent
  442.      read FOnOOBDataIsAvailable write FOnOOBDataIsAvailable;
  443.     property OnDataCanBeSent    : TWSAEvent
  444.      read FOnDataCanBeSent write FOnDataCanBeSent;
  445.     property OnSessionClosed      : TWSAEvent
  446.      read FOnSessionClosed write FOnSessionClosed;
  447.     property OnSessionIsAvailable : TWSAEvent
  448.      read FOnSessionIsAvailable write FOnSessionIsAvailable;
  449.     property OnSessionConnected   : TWSAEvent
  450.      read FOnSessionConnected write FOnSessionConnected;
  451.     property OnErrorOccurred      : TWSAError
  452.      read FOnErrorOccurred write FOnErrorOccurred;
  453.   end;
  454. { External calls to Winsock DLL functions; names are kept the same }
  455. { to ease documentation lookup                                     }
  456. function accept(     TheSocket        : TSocket;
  457.                  var TheAddress       : Internet_Socket_Address;
  458.                  var TheAddressLength : Integer
  459.                ) : TSocket; stdcall;
  460. function bind(     TheSocket     : TSocket;
  461.                var TheAddress    : Internet_Socket_Address;
  462.                    TheNameLength : Integer
  463.              ) : Integer; stdcall;
  464. function closesocket( TheSocket : TSocket ) : Integer; stdcall;
  465. function connect(      TheSocket     : TSocket;
  466.                   var  TheName       : Internet_Socket_Address;
  467.                        TheNameLength : Integer
  468.                 ) : Integer; stdcall;
  469. function ioctlsocket(      TheSocket           : TSocket;
  470.                            TheCommand          : longint;
  471.                       var  TheCommandParameter : u_long
  472.                     ) : Integer; stdcall;
  473. function getpeername(     TheSocket     : TSocket;
  474.                       var TheName       : Internet_Socket_Address;
  475.                       var TheNameLength : Integer
  476.                     ) : Integer; stdcall;
  477. function getsockname(      TheSocket    : TSocket;
  478.                       var  TheName      : Internet_Socket_Address;
  479.                       var TheNameLength : Integer
  480.                     ) : Integer; stdcall;
  481. function getsockopt(     TheSocket             : TSocket;
  482.                          TheStackLevel         : Integer;
  483.                          TheOptionName         : Integer;
  484.                          TheOptionStatus       : PChar;
  485.                      var TheOptionStatusLength : Integer
  486.                    ) : Integer; stdcall;
  487. function htonl( HostOrderLongInt : Unsigned_Long_Integer ) :
  488.           Unsigned_Long_Integer; stdcall;
  489. function htons( HostOrderShortInt : Unsigned_Short_Integer ) :
  490.           Unsigned_Short_Integer; stdcall;
  491. function inet_addr( IPAddressName : PChar ) :
  492.           Unsigned_Long_Integer; stdcall;
  493. function inet_ntoa( Socket_IP_Address:  Internet_Address ) :
  494.           PChar; stdcall;
  495. function listen( TheSocket : TSocket; Backlog : Integer ) :
  496.           Integer; stdcall;
  497. function ntohl( NetOrderLongInt : Unsigned_Long_Integer ) :
  498.           Unsigned_Long_Integer; stdcall;
  499. function ntohs( NetOrderShortInt : Unsigned_Short_Integer ) :
  500.           Unsigned_Short_Integer; stdcall;
  501. function recv( TheSocket     : TSocket;
  502.                TheDataBuffer : PChar;
  503.                TheDataLength : Integer;
  504.                TheFlags      : Integer
  505.              ) : Integer; stdcall;
  506. function recvfrom(     TheSocket                 : TSocket;
  507.                        TheDataBuffer             : PChar;
  508.                        TheDataLength             : Integer;
  509.                        TheFlags                  : Integer;
  510.                    var SocketToReceiveFrom       : Internet_Socket_Address;
  511.                    var SocketToReceiveFromLength : Integer
  512.                  ) : Integer; stdcall;
  513. function send( TheSocket     : TSocket;
  514.                TheDataBuffer : PChar;
  515.                TheDataLength : Integer;
  516.                TheFlags      : Integer
  517.              ) : Integer; stdcall;
  518. function sendto(     TheSocket            : TSocket;
  519.                      TheDataBuffer        : PChar;
  520.                      TheDataLength        : Integer;
  521.                      TheFlags             : Integer;
  522.                  var SocketToSendTo       : Internet_Socket_Address;
  523.                      SocketToSendToLength : Integer
  524.                ) : Integer; stdcall;
  525. function setsockopt( TheSocket             : TSocket;
  526.                      TheStackLevel         : Integer;
  527.                      TheOptionName         : Integer;
  528.                      TheOptionStatus       : PChar;
  529.                      TheOptionStatusLength : Integer
  530.                    ) : Integer; stdcall;
  531. function shutdown( TheSocket        : TSocket;
  532.                    ActionToShutDown : Integer
  533.                  ) : Integer; stdcall;
  534. function socket( AddressFamily : Integer;
  535.                  SocketType    : Integer;
  536.                  ProtocolCode  : Integer
  537.                ) : TSocket; stdcall;
  538. function gethostbyaddr( TheAddress    : Pointer;
  539.                         TheDataLength : Integer;
  540.                         SocketType    : Integer
  541.                       ) : PHost_Entry; stdcall;
  542. function gethostbyname( TheName : PChar ) :
  543.           PHost_Entry; stdcall;
  544. function gethostname( TheName : PChar; TheLength : Integer ) : Integer; stdcall;
  545. function getservbyport( PortCode     : Integer;
  546.                         ProtocolName : PChar
  547.                       ) : PServer_Entry; stdcall;
  548. function getservbyname( TheName      : PChar;
  549.                         ProtocolName : PChar
  550.                       ) : PServer_Entry; stdcall;
  551. function getprotobynumber( ProtocolCode : Integer ) :
  552.           PProtocol_Entry; stdcall;
  553. function getprotobyname( TheName : PChar ) :
  554.           PProtocol_Entry; stdcall;
  555. { Winsock Asynchronous Message-based Extensions to Berkeley Sockets }
  556. function WSAStartup(     wVersionRequired : word;
  557.                      var WIDRecord        : Winsock_Implementation_Data
  558.                    ) : Integer; stdcall;
  559. function WSACleanup : Integer; stdcall;
  560. procedure WSASetLastError( ErrorCode : Integer ); stdcall;
  561. function WSAGetLastError : Integer; stdcall;
  562. function WSAIsBlocking : Boolean; stdcall;
  563. function WSAUnhookBlockingHook: Integer; stdcall;
  564. function WSASetBlockingHook( TheBlockingFunction : TFarProc ) : TFarProc; stdcall;
  565. function WSACancelBlockingCall : Integer; stdcall;
  566. function WSAAsyncGetServByName( Handle          : HWND;
  567.                                 Msg             : Unsigned_Integer;
  568.                                 TheName         : PChar;
  569.                                 ProtocolName    : PChar;
  570.                                 TheDataBuffer   : PChar;
  571.                                 TheBufferLength : Integer
  572.                               ) : THandle; stdcall;
  573. function WSAAsyncGetServByPort( Handle          : HWND;
  574.                                 Msg             : Unsigned_Integer;
  575.                                 PortCode        : SmallInt;
  576.                                 ProtocolName    : PChar;
  577.                                 TheDataBuffer   : PChar;
  578.                                 TheBufferLength : Integer
  579.                               ) : THandle; stdcall;
  580. function WSAAsyncGetProtoByName( Handle          : HWND;
  581.                                  Msg             : Unsigned_Integer;
  582.                                  TheName         : PChar;
  583.                                  TheDataBuffer   : PChar;
  584.                                  TheBufferLength : Integer
  585.                                ) : THandle; stdcall;
  586. function WSAAsyncGetProtoByNumber( Handle            : HWND;
  587.                                    Msg               : Unsigned_Integer;
  588.                                    HBOProtocolNumber : Integer;
  589.                                    TheDataBuffer     : PChar;
  590.                                    TheBufferLength   : Integer
  591.                                  ) : THandle; stdcall;
  592. function WSAAsyncGetHostByName( Handle          : HWND;
  593.                                 Msg             : Unsigned_Integer;
  594.                                 TheName         : PChar;
  595.                                 TheDataBuffer   : PChar;
  596.                                 TheBufferLength : Integer
  597.                               ) : THandle; stdcall;
  598. function WSAAsyncGetHostByAddr( Handle          : HWND;
  599.                                 Msg             : Unsigned_Integer;
  600.                                 TheAddress      : PChar;
  601.                                 TheDataLength   : Integer;
  602.                                 AddressType     : Integer;
  603.                                 TheDataBuffer   : PChar;
  604.                                 TheBufferLength : Integer
  605.                                ) : THandle; stdcall;
  606. function WSACancelAsyncRequest( Handle : THandle) :
  607.           Integer; stdcall;
  608. function WSAAsyncSelect( TheSocket       : TSocket;
  609.                          Handle          : HWND;
  610.                          Msg             : Unsigned_Integer;
  611.                          AsynchEventCode : Integer
  612.                        ) : Integer; stdcall;
  613.  
  614.  
  615. implementation
  616.  
  617. const
  618.   winsocket = 'wsock32.dll';
  619.  
  620. function accept;            external    winsocket name 'accept';
  621. function bind;              external    winsocket name 'bind';
  622. function closesocket;       external    winsocket name 'closesocket';
  623. function connect;           external    winsocket name 'connect';
  624. function getpeername;       external    winsocket name 'getpeername';
  625. function getsockname;       external    winsocket name 'getsockname';
  626. function getsockopt;        external    winsocket name 'getsockopt';
  627. function htonl;             external    winsocket name 'htonl';
  628. function htons;             external    winsocket name 'htons';
  629. function inet_addr;         external    winsocket name 'inet_addr';
  630. function inet_ntoa;         external    winsocket name 'inet_ntoa';
  631. function ioctlsocket;       external    winsocket name 'ioctlsocket';
  632. function listen;            external    winsocket name 'listen';
  633. function ntohl;             external    winsocket name 'ntohl';
  634. function ntohs;             external    winsocket name 'ntohs';
  635. function recv;              external    winsocket name 'recv';
  636. function recvfrom;          external    winsocket name 'recvfrom';
  637. function send;              external    winsocket name 'send';
  638. function sendto;            external    winsocket name 'sendto';
  639. function setsockopt;        external    winsocket name 'setsockopt';
  640. function shutdown;          external    winsocket name 'shutdown';
  641. function socket;            external    winsocket name 'socket';
  642. function gethostbyaddr;     external    winsocket name 'gethostbyaddr';
  643. function gethostbyname;     external    winsocket name 'gethostbyname';
  644. function getprotobyname;    external    winsocket name 'getprotobyname';
  645. function getprotobynumber;  external    winsocket name 'getprotobynumber';
  646. function getservbyname;     external    winsocket name 'getservbyname';
  647. function getservbyport;     external    winsocket name 'getservbyport';
  648. function gethostname;       external    winsocket name 'gethostname';
  649. function WSAAsyncSelect;    external    winsocket name 'WSAAsyncSelect';
  650. function WSAAsyncGetHostByAddr; external winsocket name 'WSAAsyncGetHostByAddr';
  651. function WSAAsyncGetHostByName; external winsocket name 'WSAAsyncGetHostByName';
  652. function WSAAsyncGetProtoByNumber; external winsocket name 'WSAAsyncGetProtoByNumber';
  653. function WSAAsyncGetprotoByName; external winsocket name 'WSAAsyncGetprotoByName';
  654. function WSAAsyncGetServByPort; external winsocket name 'WSAAsyncGetServByPort';
  655. function WSAAsyncGetServByName; external winsocket name 'WSAAsyncGetServByName';
  656. function WSACancelAsyncRequest; external winsocket name 'WSACancelAsyncRequest';
  657. function WSASetBlockingHook; external    winsocket name 'WSASetBlockingHook';
  658. function WSAUnhookBlockingHook; external winsocket name 'WSAUnhookBlockingHook';
  659. function WSAGetLastError;    external    winsocket name 'WSAGetLastError';
  660. procedure WSASetLastError;   external    winsocket name 'WSASetLastError';
  661. function WSACancelBlockingCall; external winsocket name 'WSACancelBlockingCall';
  662. function WSAIsBlocking;     external     winsocket name 'WSAIsBlocking';
  663. function WSAStartup;        external     winsocket name 'WSAStartup';
  664. function WSACleanup;        external     winsocket name 'WSACleanup';
  665.  
  666. { This is the override create method for the socket component }
  667. constructor TCCSocket.Create( AOwner : TComponent );
  668. var
  669.   ReturnCode : Integer; { Used to signal error }
  670. begin
  671.   { Call inherited first! }
  672.   inherited Create( AOwner );
  673.   { Enable Asynch mode since in Windows }
  674.   FBlockingMode := false;
  675.   { Set Timeout for asynch ops }
  676.   FTimeoutValue := 30;
  677.   { Set up no sockets in the two native vars }
  678.   FSocket := INVALID_SOCKET;
  679.   FMasterSocket := INVALID_SOCKET;
  680.   { Start up Winsock }
  681.   ReturnCode := WSAStartup( $101 , Socket_WSA_Data );
  682.   { If don't get 0 store the error code }
  683.   if ReturnCode <> 0 then SetSocketErrorData( 'Constructor (WSAStartup)' );
  684. end;
  685.  
  686. { This is the destroy override method }
  687. destructor TCCSocket.Destroy;
  688. var
  689.   ReturnCode : Integer; { Holds possible error code }
  690. begin
  691.   { Attempt to shut down winsock }
  692.   ReturnCode := WSACleanup;
  693.   { If didn't get 0 save the error }
  694.   if ReturnCode < 0 then SetSocketErrorData( 'Destructor (WSACleanup)' );
  695.   { call inherited }
  696.   inherited Destroy;
  697. end;
  698.  
  699. { This is just used to draw the nonvisual element during design time }
  700. procedure TCCSocket.TWMPaint( var Msg : TWMPaint );
  701. var
  702.   TheIcon : HIcon; { Internal icon }
  703.   TheDC   : HDC;   { Internal dc   }
  704. begin
  705.   { If in design mode draw the icon }
  706.   if csDesigning in ComponentState then
  707.   begin
  708.     { Load the icon from the instance via the DCR file }
  709.     TheIcon := LoadIcon( HInstance , MAKEINTRESOURCE( 'TCCSocket' ));
  710.     { Get a device context }
  711.     TheDC := GetDC( Handle );
  712.     { Set the internal width to that of an icon }
  713.     Width := 32;
  714.     Height := 32;
  715.     { Display the icon }
  716.     DrawIcon( TheDC , 0 , 0 , TheIcon );
  717.     { Get rid of the evidence }
  718.     ReleaseDC( Handle , TheDC );
  719.     FreeResource( TheIcon );
  720.   end;
  721.   { Let Windows know drawing is done }
  722.   ValidateRect( Handle , nil );
  723. end;
  724.  
  725. { Function to return Asynch mode }
  726. function TCCSocket.SocketIsNotBlocking: Boolean;
  727. begin
  728.   { return inverse of blocking mode }
  729.   SocketIsNotBlocking := not FBlockingMode;
  730. end;
  731.  
  732. { This turns off asynch mode via inverse of parameter }
  733. procedure TCCSocket.ActivateBlockingMode( BeginBlocking: Boolean );
  734. begin
  735.   FBlockingMode := not BeginBlocking;
  736. end;
  737.  
  738. { This is a full access method to send a string over the socket }
  739. procedure TCCSocket.SetStringData( TheData : string );
  740. var
  741.   BytesLeftToSend   ,                         { Counter for remaining data }
  742.   BytesSentSoFar    : Integer;                { Counter for sent data      }
  743.   DataBuffer        : array[0..256] of char;  { Buffer for string          }
  744.   DataBufferPointer : PChar;                  { Pointer to buffer          }
  745. begin
  746.   { Copy string into char array }
  747.   StrPCopy( DataBuffer , TheData );
  748.   { Move the pointer to the array's first element into the PChar }
  749.   DataBufferPointer := @DataBuffer[ 0 ];
  750.   { Count the total chars to send }
  751.   BytesLeftToSend := Length( TheData );
  752.   { Run a loop to send the string over the socket }
  753.   while BytesLeftToSend > 0 do
  754.   begin
  755.     { Start a timeout timer if not in blocking mode }
  756.     if not FBlockingMode then ActivateNonAsynchTimeout;
  757.     { Send some bytes over the net }
  758.     BytesSentSoFar := send( FSocket , DataBufferPointer , BytesLeftToSend , 0 );
  759.     { End timeout timer if not blocking }
  760.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  761.     { If get a negative response code then signal error }
  762.     if BytesSentSoFar < 0 then
  763.     begin
  764.       { Save the error data }
  765.       SetSocketErrorData( 'SetStringData (Send)' );
  766.     end
  767.     else
  768.     begin
  769.       { Decrement total bytes left to send }
  770.       BytesLeftToSend := BytesLeftToSend - BytesSentSoFar;
  771.       { Increment pointer into the string }
  772.       DataBufferPointer := DataBufferPointer + BytesSentSoFar;
  773.     end;
  774.   end;
  775. end;
  776.  
  777. { This is a full access method to read a string from the socket }
  778. function TCCSocket.GetStringData: string;
  779. var
  780.   TheDataLength     : Integer; { Length of data received }
  781.   DataBuffer        : string;  { String to store data in }
  782.   DataBufferArray   : array[ 0 .. 256 ] of char absolute DataBuffer;
  783.                                { Map Pointer to string on stack }
  784. begin
  785.   { If the socket has been set up try to get some data }
  786.   if FSocket <> INVALID_SOCKET then
  787.   begin
  788.     { Activate timeout timer if not in blocking mode }
  789.     if not FBlockingMode then ActivateNonAsynchTimeout;
  790.     { Do a receive on any data waiting at the socket }
  791.     TheDataLength := recv( FSocket , @DataBufferArray[ 1 ] , 255 , 0 );
  792.     { If not blocking kill timeout timer }
  793.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  794.     { If negative data length then set error }
  795.     if TheDataLength < 0 then
  796.     begin
  797.       { Set the socket error conditions }
  798.       SetSocketErrorData( 'GetStringData (Recv)' );
  799.       { Return nothing }
  800.       Result := '';
  801.     end
  802.     else
  803.     begin
  804.       { Set up pascal style string }
  805.       DataBufferArray[ 0 ] := Chr( TheDataLength );
  806.       { And return the prepared string as result }
  807.       Result := DataBuffer;
  808.     end;
  809.   end
  810.   else Result := ''; { Return empty string if invalid socket }
  811. end;
  812.  
  813. { This is a full access method to send a string as OOB data }
  814. procedure TCCSocket.SetStringDataOutOfBand( TheData: string );
  815. var
  816.   BytesLeftToSend   ,                         { Counter for remaining data }
  817.   BytesSentSoFar    : Integer;                { Counter for sent data      }
  818.   DataBuffer        : array[0..256] of char;  { Buffer for string          }
  819.   DataBufferPointer : PChar;                  { Pointer to buffer          }
  820. begin
  821.   { Copy string into char array }
  822.   StrPCopy( DataBuffer , TheData );
  823.   { Move the pointer to the array's first element into the PChar }
  824.   DataBufferPointer := @DataBuffer[ 0 ];
  825.   { Count the total chars to send }
  826.   BytesLeftToSend := Length( TheData );
  827.   { Run a loop to send the string over the socket }
  828.   while BytesLeftToSend > 0 do
  829.   begin
  830.     { Start a timeout timer if not in blocking mode }
  831.     if not FBlockingMode then ActivateNonAsynchTimeout;
  832.     { Send some bytes over the net }
  833.     BytesSentSoFar := send( FSocket , DataBufferPointer ,
  834.                             BytesLeftToSend , MSG_OOB );
  835.     { End timeout timer if not blocking }
  836.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  837.     { If get a negative response code then signal error }
  838.     if BytesSentSoFar < 0 then
  839.     begin
  840.       { Save the error data }
  841.       SetSocketErrorData( 'SetStringDataOutOfBand (Send)' );
  842.     end
  843.     else
  844.     begin
  845.       { Decrement total bytes left to send }
  846.       BytesLeftToSend := BytesLeftToSend - BytesSentSoFar;
  847.       { Increment pointer into the string }
  848.       DataBufferPointer := DataBufferPointer + BytesSentSoFar;
  849.     end;
  850.   end;
  851. end;
  852.  
  853. { This is a full access method to receive out of band data as a string }
  854. function TCCSocket.GetStringDataOutOfBand: string;
  855. var
  856.   TheDataLength     : Integer; { Length of data received }
  857.   DataBuffer        : string;  { String to store data in }
  858.   DataBufferArray   : array[ 0 .. 256 ] of char absolute DataBuffer;
  859.                                { Map Pointer to string on stack }
  860. begin
  861.   { If the socket has been set up try to get some data }
  862.   if FSocket <> INVALID_SOCKET then
  863.   begin
  864.     { Activate timeout timer if not in blocking mode }
  865.     if not FBlockingMode then ActivateNonAsynchTimeout;
  866.     { Do a receive on any data waiting at the socket }
  867.     TheDataLength := recv( FSocket , @DataBufferArray[ 1 ] , 255 , MSG_OOB );
  868.     { If not blocking kill timeout timer }
  869.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  870.     { If negative data length then set error }
  871.     if TheDataLength < 0 then
  872.     begin
  873.       { Set the socket error conditions }
  874.       SetSocketErrorData( 'GetStringDataOutOfBand (Recv)' );
  875.       { Return nothing }
  876.       Result := '';
  877.     end
  878.     else
  879.     begin
  880.       { Set up pascal style string }
  881.       DataBufferArray[ 0 ] := Chr( TheDataLength );
  882.       { And return the prepared string as result }
  883.       Result := DataBuffer;
  884.     end;
  885.   end
  886.   else Result := ''; { Return empty string if invalid socket }
  887. end;
  888.  
  889. function TCCSocket.PeekCurrentData: string;
  890. var
  891.   TheDataLength     : Integer; { Length of data received }
  892.   DataBuffer        : string;  { String to store data in }
  893.   DataBufferArray   : array[ 0 .. 256 ] of char absolute DataBuffer;
  894.                                { Map Pointer to string on stack }
  895. begin
  896.   { If the socket has been set up try to get some data }
  897.   if FSocket <> INVALID_SOCKET then
  898.   begin
  899.     { Activate timeout timer if not in blocking mode }
  900.     if not FBlockingMode then ActivateNonAsynchTimeout;
  901.     { Do a receive on any data waiting at the socket }
  902.     TheDataLength := recv( FSocket , @DataBufferArray[ 1 ] , 255 , MSG_PEEK );
  903.     { If not blocking kill timeout timer }
  904.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  905.     { If negative data length then set error }
  906.     if TheDataLength < 0 then
  907.     begin
  908.       { Set the socket error conditions }
  909.       SetSocketErrorData( 'PeekCurrentData (PeekData)' );
  910.       { Return nothing }
  911.       Result := '';
  912.     end
  913.     else
  914.     begin
  915.       { Set up pascal style string }
  916.       DataBufferArray[ 0 ] := Chr( TheDataLength );
  917.       { And return the prepared string as result }
  918.       Result := DataBuffer;
  919.     end;
  920.   end
  921.   else Result := ''; { Return empty string if invalid socket }
  922. end;
  923.  
  924. { This is a full access method to get the port id for a given socket }
  925. function TCCSocket.GetSocketPort( TheSocket : TSocket ) : string;
  926. var
  927.   TheAddress       : Internet_Socket_Address;  { Hold address info     }
  928.   TheAddressLength : Integer;                  { Hold addr info length }
  929. begin
  930.   { Find out the size of the structure }
  931.   TheAddressLength := SizeOf( TheAddress );
  932.   { Call the winsock dll routine }
  933.   getsockname( TheSocket , TheAddress , TheAddressLength );
  934.   { Pull off the properly-byte-ordered port number as a string }
  935.   Result := IntToStr( ntohs( TheAddress.Socket_Port ));
  936. end;
  937.  
  938. { This is a full access method to get the IP Address of a given socket }
  939. function TCCSocket.GetSocketIPAddress( TheSocket : TSocket ) : string;
  940. var
  941.   TheAddress       : Internet_Socket_Address; { Holds address info   }
  942.   TheAddressLength : Integer;                 { Holds size of info   }
  943.   AddressPChar     : PChar;                   { holds converted info }
  944. begin
  945.   { Get the size of the address record }
  946.   TheAddressLength := SizeOf( TheAddress );
  947.   { Call the Winsock DLL function }
  948.   getsockname( TheSocket , TheAddress , TheAddressLength );
  949.   { Make the conversion from 32 bit to dotted decimal }
  950.   AddressPChar := inet_ntoa( TheAddress.Socket_Address );
  951.   { return it as a pascal string }
  952.   Result := StrPas( AddressPChar );
  953. end;
  954.  
  955. { This is a full access method to get the port number of the other end of a socket }
  956. function TCCSocket.GetSocketPeerPort( TheSocket : TSocket ) : string;
  957. var
  958.   TheAddress       : Internet_Socket_Address;  { Hold address info     }
  959.   TheAddressLength : Integer;                  { Hold addr info length }
  960. begin
  961.   { Find out the size of the structure }
  962.   TheAddressLength := SizeOf( TheAddress );
  963.   { Call the winsock dll routine }
  964.   getpeername( TheSocket , TheAddress , TheAddressLength );
  965.   { Pull off the properly-byte-ordered port number as a string }
  966.   Result := IntToStr( ntohs( TheAddress.Socket_Port ));
  967. end;
  968.  
  969. { This is a full access method to get the ip address of the other end of a socket }
  970. function TCCSocket.GetSocketPeerIPAddress(TheSocket: TSocket): string;
  971. var
  972.   TheAddress       : Internet_Socket_Address; { Holds address info   }
  973.   TheAddressLength : Integer;                 { Holds size of info   }
  974.   AddressPChar     : PChar;                   { holds converted info }
  975. begin
  976.   { Get the size of the address record }
  977.   TheAddressLength := SizeOf( TheAddress );
  978.   { Call the Winsock DLL function }
  979.   getpeername( TheSocket , TheAddress , TheAddressLength );
  980.   { Make the conversion from 32 bit to dotted decimal }
  981.   AddressPChar := inet_ntoa( TheAddress.Socket_Address );
  982.   { return it as a pascal string }
  983.   Result := StrPas( AddressPChar );
  984. end;
  985.  
  986. { This is a full access method to receive a PChar of up to 64K of data at once }
  987. function TCCSocket.CCSockReceive(    TheSocket     : TSocket;
  988.                                      TheTextBuffer : PChar;
  989.                                  var TheTextLength : Integer
  990.                                 ) : Integer;
  991. begin
  992.   { If not an invalid socket then do the receive }
  993.   if FSocket <> INVALID_SOCKET then
  994.   begin
  995.     { If not in block mode then activate timeout timer }
  996.     if not FBlockingMode then ActivateNonAsynchTimeout;
  997.     { Return the direct result of the recv call into Winsock }
  998.     Result := recv( TheSocket , TheTextBuffer , TheTextLength , 0 );
  999.     { If not blocking kill timeout timer }
  1000.     if not FBlockingMode then DeactivateNonAsynchTimeout;
  1001.     { If negative length then get error info }
  1002.     if TheTextLength < 0 then SetSocketErrorData( 'CCSockReceive' );
  1003.   end
  1004.   else Result := -1; { Return invalid PChar if not valid socket }
  1005. end;
  1006.  
  1007. { This is a full access method to send a PChar of up to 64K of data at once }
  1008. function TCCSocket.CCSockSend(    TheSocket     : TSocket;
  1009.                                   TheTextBuffer : PChar;
  1010.                               var TheTextLength : Integer
  1011.                              ) : Integer;
  1012. begin
  1013.   { If not blocking then activate timeout timer }
  1014.   if not FBlockingMode then ActivateNonAsynchTimeout;
  1015.   { Send the info through raw }
  1016.   TheTextLength := send( TheSocket , TheTextBuffer , TheTextLength , 0 );
  1017.   { if not blocking then deactivate timeout timer }
  1018.   if not FBlockingMode then DeactivateNonAsynchTimeout;
  1019.   { if error code then get winsock error status }
  1020.   if TheTextLength < 0 then SetSocketErrorData( 'CCSockSend' );
  1021.   { return SOCKET_ERROR or number of bytes sent }
  1022.   Result := TheTextLength;
  1023. end;
  1024.  
  1025. { This method handles Asynchronous Windows messages for the Winsock }
  1026. procedure TCCSocket.WMASyncSelect( var Msg : TMessage );
  1027. begin
  1028.   { The low word of the lParam field of the Msg is the event code }
  1029.   case LoWord( Msg.lParam ) of
  1030.     { This indicates data is available for reading on the socket }
  1031.     FD_READ : begin
  1032.                 if Assigned( FOnDataIsAvailable ) then
  1033.                  FOnDataIsAvailable( Self , Msg.wParam ); { wParam = socket ID }
  1034.               end;
  1035.     { This indicates data is available for sending on the socket }
  1036.     FD_WRITE : begin
  1037.                 if Assigned( FOnDataCanBeSent ) then
  1038.                  FOnDataCanBeSent( Self , Msg.wParam );
  1039.               end;
  1040.     { This indicates OOB data is available for reading on the socket }
  1041.     FD_OOB : begin
  1042.                 if Assigned( FOnOOBDataIsAvailable ) then
  1043.                  FOnOOBDataIsAvailable( Self , Msg.wParam );
  1044.               end;
  1045.     { This indicates the socket has an incoming connection for accept }
  1046.     FD_ACCEPT : begin
  1047.                   if Assigned( FOnSessionIsAvailable ) then
  1048.                    FOnSessionIsAvailable( Self , Msg.wParam );
  1049.                 end;
  1050.     { This indicates an outgoing connection has been accepted by peer }
  1051.     FD_CONNECT: begin
  1052.                   if Assigned( FOnSessionConnected ) then
  1053.                    FOnSessionConnected( Self , Msg.wParam );
  1054.                 end;
  1055.     { This indicates the socket has been closed; presumably by peer }
  1056.     FD_CLOSE : begin
  1057.                  if Assigned( FOnSessionClosed ) then
  1058.                   FOnSessionClosed( Self , Msg.wParam );
  1059.                end;
  1060.   end;
  1061. end;
  1062.  
  1063. { This handles Asynchronous Timeouts gracefully }
  1064. procedure TCCSocket.WMTimer( var Msg : TMessage );
  1065. begin
  1066.   { Kill a running timer }
  1067.   KillTimer( Handle , 10 );
  1068.   { If the socket is blocking then deal with timeout }
  1069.   if WSAIsBlocking then
  1070.   begin
  1071.     { Cancel the blocking operation }
  1072.     WSACancelBlockingCall;
  1073.     { Return blocking call timeout error message }
  1074.     if Assigned( FOnErrorOccurred ) then
  1075.       FOnErrorOccurred( Self , WSAETIMEDOUT , 'Blocking call timed out' );
  1076.   end;
  1077. end;
  1078.  
  1079. { This is a wrapper method around the complexity of connecting a socket }
  1080. procedure TCCSocket.CCSockConnect;
  1081. var
  1082.   ReturnCode : Integer;                    { Generic return code var }
  1083.   TcpPChar   : PChar;                      { Boilerplate TCP string  }
  1084.   PortName   : array[ 0 .. 31 ] of char;   { PChar for port name     }
  1085.   DataBuffer : array[ 0 .. 256 ] of char;  { Generic buffer PChar    }
  1086.   DummyValue : longint;                    { Must use variable call  }
  1087. begin
  1088.   { No port name set error }
  1089.   if FPort_Name = '' then
  1090.   begin
  1091.     SetSocketErrorData( 'No Valid Port Name in CCSockConnect');
  1092.     exit;
  1093.   end;
  1094.   { No IP address set error }
  1095.   if FIP_Address_Name = '' then
  1096.   begin
  1097.     SetSocketErrorData( 'No Valid IP Address in CCSockConnect');
  1098.     exit;
  1099.   end;
  1100.   { Set required family value }
  1101.   Socket_IP_Address.Socket_Family := AF_INET;
  1102.   { Move the port name into the PChar }
  1103.   StrPCopy( PortName , FPort_Name );
  1104.   { Set up the boilerplate pchar }
  1105.   TcpPChar := 'tcp';
  1106.   { Do blocking call on server }
  1107.   Socket_Server_Entry := getservbyname( PortName , TcpPChar );
  1108.   { If no reply then use default from name }
  1109.   if Socket_Server_Entry = nil then
  1110.   begin
  1111.     Socket_IP_Address.Socket_Port := htons( StrToInt( StrPas( PortName )));
  1112.   end
  1113.   else
  1114.   begin
  1115.     { Otherwise use the replied value }
  1116.     Socket_IP_Address.Socket_Port := Socket_Server_Entry^.Server_Port;
  1117.   end;
  1118.   { Move the IP address into the data buffer }
  1119.   StrPCopy( DataBuffer , FIP_Address_Name );
  1120.   { Turn it into a real IP address in binary form }
  1121.   Socket_IP_Address.Socket_Address.Full_Internet_Address :=
  1122.    inet_addr( DataBuffer );
  1123.   { If not found then do remote lookup }
  1124.   if Socket_IP_Address.Socket_Address.Full_Internet_Address = INADDR_NONE then
  1125.   begin
  1126.     { Call blocking function on IP name }
  1127.     Socket_Host_Entry := gethostbyname( DataBuffer );
  1128.     { If still no good then error out and exit }
  1129.     if Socket_Host_Entry = nil then
  1130.     begin
  1131.       SetSocketErrorData( 'Cannot convert host address in CCSockConnect');
  1132.       exit;
  1133.     end;
  1134.     { Otherwise get the address }
  1135.     Socket_IP_Address.Socket_Address := Socket_Host_Entry^.Host_Address^^;
  1136.   end;
  1137.   { Do protocol acquisition via blocking call }
  1138.   Socket_Protocol_Entry := getprotobyname( TcpPChar );
  1139.   { Create a socket }
  1140.   FSocket := socket( PF_INET ,
  1141.                      SOCK_STREAM ,
  1142.                      Socket_Protocol_Entry^.Protocol_Id );
  1143.   { If error code then exit with value set }
  1144.   if FSocket < 0 then
  1145.   begin
  1146.     SetSocketErrorData('CCSockConnect (socket)');
  1147.     exit;
  1148.   end;
  1149.   { If asynchmode then setup for asynch calls }
  1150.   if not FBlockingMode then
  1151.   begin
  1152.     { Do ass call and allow all callback states; note this will }
  1153.     { send a message when connected.                            }
  1154.     ReturnCode := WSAASyncSelect( FSocket , Handle , WM_ASYNCSELECT ,
  1155.       FD_READ or FD_WRITE or FD_OOB or FD_CLOSE or FD_CONNECT );
  1156.     { If get error say so }
  1157.     if ReturnCode <> 0 then SetSocketErrorData( 'WSAAsyncSelect' );
  1158.   end
  1159.   else
  1160.   begin
  1161.     { Otherwise set blocking mode }
  1162.     DummyValue := 0;
  1163.     ioctlsocket( FSocket , FIONBIO , DummyValue );
  1164.     { Set up timeout on blocking call }
  1165.     ActivateNonAsynchTimeout;
  1166.     { Attempt blocking connect }
  1167.     ReturnCode := connect( FSocket ,
  1168.                            Socket_IP_Address ,
  1169.                            SizeOf( Socket_IP_Address ));
  1170.     { Deactivate timeout on blocking call }
  1171.     DeactivateNonAsynchTimeout;
  1172.     { If any other error than WouldBlock signal connection error }
  1173.     if ReturnCode <> 0 then
  1174.     begin
  1175.       ReturnCode := WSAGetLastError;
  1176.       if ReturnCode <> WSAEWOULDBLOCK then
  1177.        SetSocketErrorData( 'CCSockConnect' );
  1178.     end;
  1179.   end;
  1180. end;
  1181.  
  1182. { This is a method to set the socket to a listening mode (ie server) }
  1183. procedure TCCSocket.CCSockListen;
  1184. var
  1185.   ReturnCode : Integer;
  1186.   TcpPChar   : PChar;
  1187.   PortName   : array[0..31] of char;
  1188.   DummyValue : Longint;
  1189.   { szData: array[0..256] of char;}
  1190. begin
  1191.   DummyValue := 0;
  1192.   { Invalid Port Name error }
  1193.   if FPort_Name = '' then
  1194.   begin
  1195.     SetSocketErrorData( 'No Port Specified in CCSockListen' );
  1196.     exit;
  1197.   end;
  1198.   { Set default AF_INET family }
  1199.   Socket_IP_Address.Socket_Family := AF_INET;
  1200.   { Set any IP Address }
  1201.   Socket_IP_Address.Socket_Address.Full_Internet_Address := INADDR_ANY;
  1202.   { Set default TCP string }
  1203.   TcpPChar := 'tcp';
  1204.   { Create PChar of port name }
  1205.   StrPCopy( PortName , FPort_Name );
  1206.   { Use blocking call to get server }
  1207.   Socket_Server_Entry := getservbyname( PortName , TcpPChar );
  1208.   { If no entry the use default number otherwise use returned one }
  1209.   if Socket_Server_Entry = nil then
  1210.      Socket_IP_Address.Socket_Port := htons( StrToInt( StrPas( PortName )))
  1211.   else Socket_IP_Address.Socket_Port := Socket_Server_Entry^.Server_Port;
  1212.   { Use blocking call to get protocol }
  1213.   Socket_Protocol_Entry := getprotobyname( TcpPChar );
  1214.   { Set up the server socket }
  1215.   FMasterSocket := socket( PF_INET     ,
  1216.                            SOCK_STREAM ,
  1217.                            Socket_Protocol_Entry^.Protocol_Id );
  1218.   { If socket error return code and exit }
  1219.   if FMasterSocket < 0 then
  1220.   begin
  1221.     SetSocketErrorData( 'socket' );
  1222.     exit;
  1223.   end;
  1224.   { Bind the server socket }
  1225.   ReturnCode := bind( FMasterSocket ,
  1226.                       Socket_IP_Address,
  1227.                       SizeOf( Socket_IP_Address ));
  1228.   { If socket error then signal and exit }
  1229.   if ReturnCode <> 0 then
  1230.   begin
  1231.     SetSocketErrorData( 'Bind' );
  1232.     exit;
  1233.   end;
  1234.   { Do a listen call to set up waiting state }
  1235.   ReturnCode := listen( FMasterSocket , 5 );
  1236.   { If socket error then signal and exit }
  1237.   if ReturnCode <> 0 then
  1238.   begin
  1239.     SetSocketErrorData( 'Listen' );
  1240.     exit;
  1241.   end;
  1242.   { If not blocking do asynch call }
  1243.   if not FBlockingMode then
  1244.   begin
  1245.     { Set up asynch call }
  1246.     ReturnCode := WSAASyncSelect( FMasterSocket  ,
  1247.                                   Handle         ,
  1248.                                   WM_ASYNCSELECT ,
  1249.                                   FD_READ or FD_WRITE or FD_OOB
  1250.                                    or FD_ACCEPT or FD_CLOSE );
  1251.     { If error then signal }
  1252.     if ReturnCode <> 0 then SetSocketErrorData('WSAASyncSelect');
  1253.   end
  1254.   else ioctlsocket( FMasterSocket , FIONBIO , DummyValue ); { otherwise set blocking }
  1255. end;
  1256.  
  1257. { This method terminates a listening mode (server) }
  1258. procedure TCCSocket.CCSockCancelListen;
  1259. var
  1260.   ReturnCode : Integer; { status code var }
  1261. begin
  1262.   { if not blocking then turn off asynch mode }
  1263.   if not FBlockingMode then
  1264.     WSAASyncSelect( FMasterSocket , Handle , WM_ASYNCSELECT , 0 );
  1265.   { Shutdown call }
  1266.   shutdown( FMasterSocket , 2 );
  1267.   { Close the socket }
  1268.   ReturnCode := closesocket( FMasterSocket );
  1269.   { If socket error signal it }
  1270.   if ReturnCode <> 0 then
  1271.     SetSocketErrorData( 'CancelListen (closesocket)' );
  1272.   { kill socket id }
  1273.   FMasterSocket := 0;
  1274. end;
  1275.  
  1276. { This is the blocking mode accept procedure }
  1277. function TCCSocket.CCSockAccept: TSocket;
  1278. var
  1279.   TheDataLength : Integer; { data length }
  1280.   DummyValue : Longint;
  1281. begin
  1282.   Dummyvalue := 0;
  1283.   { Get length of the address variable }
  1284.   TheDataLength := sizeof( Socket_IP_Address );
  1285.   { if blocking then do timeout }
  1286.   if FBlockingMode then ActivateNonAsynchTimeout;
  1287.   { Do blocking accept call }
  1288.   FSocket := accept( FMasterSocket     ,
  1289.                      Socket_IP_Address ,
  1290.                      TheDataLength       );
  1291.   { If blocking }
  1292.   if FBlockingMode then
  1293.   begin
  1294.     { Kill timeout timer }
  1295.     DeactivateNonAsynchTimeout;
  1296.     { Turn on blocking on accepted socket }
  1297.     ioctlsocket( FSocket , FIONBIO , DummyValue );
  1298.   end;
  1299.   { If no accept then signal error }
  1300.   if FSocket < 0 then SetSocketErrorData( 'Accept' );
  1301.   { Return Socket ID }
  1302.   Result := FSocket;
  1303. end;
  1304.  
  1305. { Close a socket in either mode }
  1306. procedure TCCSocket.CCSockClose;
  1307. var
  1308.   ReturnCode   : Integer;            { status code var }
  1309.   LingerRecord : Lingering_Control;  { linger var      }
  1310.   LingerArray  : array[ 0 .. 3 ] of char absolute LingerRecord;
  1311.                                      { pointer into la }
  1312. begin
  1313.   { If not blocking then turn of asynch messaging }
  1314.   if not FBlockingMode then
  1315.     WSAASyncSelect( FSocket , Handle , WM_ASYNCSELECT , 0 );
  1316.   { cancel any blocking }
  1317.   if WSAIsBlocking then WSACancelBlockingCall;
  1318.   { shut down the socket }
  1319.   shutdown( FSocket , 2 );
  1320.   { Set up the linger record }
  1321.   LingerRecord.Linger_Status := 1;
  1322.   LingerRecord.Linger_Interval := 0;
  1323.   { Set up the linger status via setsockopt }
  1324.   setsockopt( FSocket     ,
  1325.               SOL_SOCKET  ,
  1326.               SO_LINGER   ,
  1327.               LingerArray ,
  1328.               sizeof( LingerRecord ));
  1329.   { Do the close call }
  1330.   ReturnCode := closesocket( FSocket );
  1331.   { signal error if one happens }
  1332.   if ReturnCode <> 0 then SetSocketErrorData( 'Disconnect (closesocket)' );
  1333.   { set socket to invalid value }
  1334.   FSocket := INVALID_SOCKET;
  1335. end;
  1336.  
  1337. { This sets up internal values for retrieval in case errors occur }
  1338. procedure TCCSocket.SetSocketErrorData( SocketFunction : string );
  1339. begin
  1340.   { Get any winsock error }
  1341.   ErrorCode := WSAGetLastError;
  1342.   { Get text description of error }
  1343.   WinsockErrorMessage := GetSocketErrorDescription( ErrorCode );
  1344.   { Setup full error message for user friendliness }
  1345.   if WinsockErrorMessage <> 'No Error' then
  1346.    FullErrorMessage := 'Error '+ WinsockErrorMessage +
  1347.     ' in function ' + SocketFunction else FullErrorMessage :=
  1348.      SocketFunction;
  1349.   { call error event handler }
  1350.   if Assigned( FOnErrorOccurred ) then
  1351.     FOnErrorOccurred( Self , ErrorCode , FullErrorMessage );
  1352. end;
  1353.  
  1354. { Boilerplate error descriptions }
  1355. function TCCSocket.GetSocketErrorDescription( ErrorCode : Integer ) : string;
  1356. begin
  1357.   case ErrorCode of
  1358.     WSAEINTR:
  1359.       GetSocketErrorDescription := 'System Interrupt Failure';
  1360.     WSAEBADF:
  1361.       GetSocketErrorDescription := 'Bad File Failure';
  1362.     WSAEACCES:
  1363.       GetSocketErrorDescription := 'File Permission Denied Failure';
  1364.     WSAEFAULT:
  1365.       GetSocketErrorDescription := 'Bad IP Address Failure';
  1366.     WSAEINVAL:
  1367.       GetSocketErrorDescription := 'Invalid Winsock API Call Argument Failure';
  1368.     WSAEMFILE:
  1369.       GetSocketErrorDescription := 'Too Many Open Files Failure';
  1370.     WSAEWOULDBLOCK:
  1371.       GetSocketErrorDescription := 'Operation Would Block Failure';
  1372.     WSAEINPROGRESS:
  1373.       GetSocketErrorDescription := 'Operation Blocking Failure';
  1374.     WSAEALREADY:
  1375.       GetSocketErrorDescription := 'Operation Already in Progress Failure';
  1376.     WSAENOTSOCK:
  1377.       GetSocketErrorDescription := 'Invalid Socket Operation Failure';
  1378.     WSAEDESTADDRREQ:
  1379.       GetSocketErrorDescription := 'No Destination Address Failure';
  1380.     WSAEMSGSIZE:
  1381.       GetSocketErrorDescription := 'Invalid Message Length Failure';
  1382.     WSAEPROTOTYPE:
  1383.       GetSocketErrorDescription := 'Invalid Protocol For Socket Failure';
  1384.     WSAENOPROTOOPT:
  1385.       GetSocketErrorDescription := 'Unavilable Protocol Failure';
  1386.     WSAEPROTONOSUPPORT:
  1387.       GetSocketErrorDescription := 'Unsupported Protocol Failure';
  1388.     WSAESOCKTNOSUPPORT:
  1389.       GetSocketErrorDescription := 'Unsupported Socket Type Failure';
  1390.     WSAEOPNOTSUPP:
  1391.       GetSocketErrorDescription := 'Unsupported Socket Operation Failure';
  1392.     WSAEPFNOSUPPORT:
  1393.       GetSocketErrorDescription := 'Unsupported Protocol Family Failure';
  1394.     WSAEAFNOSUPPORT:
  1395.       GetSocketErrorDescription := 'Invalid Protocol-Address Family Failure';
  1396.     WSAEADDRINUSE:
  1397.       GetSocketErrorDescription := 'Address In Use Failure';
  1398.     WSAEADDRNOTAVAIL:
  1399.       GetSocketErrorDescription := 'Unavailable Address Failure';
  1400.     WSAENETDOWN:
  1401.       GetSocketErrorDescription := 'Network Down Failure';
  1402.     WSAENETUNREACH:
  1403.       GetSocketErrorDescription := 'Network Unreachable Failure';
  1404.     WSAENETRESET:
  1405.       GetSocketErrorDescription := 'Network Connection Dropped Failure';
  1406.     WSAECONNABORTED:
  1407.       GetSocketErrorDescription := 'Software Abort Failure';
  1408.     WSAECONNRESET:
  1409.       GetSocketErrorDescription := 'Peer Connection Reset Failure';
  1410.     WSAENOBUFS:
  1411.       GetSocketErrorDescription := 'Buffer Overflow Failure';
  1412.     WSAEISCONN:
  1413.       GetSocketErrorDescription := 'Connected Socket Failure';
  1414.     WSAENOTCONN:
  1415.       GetSocketErrorDescription := 'Unconnected Socket Failure';
  1416.     WSAESHUTDOWN:
  1417.       GetSocketErrorDescription := 'Closed Socket Send Failure';
  1418.     WSAETOOMANYREFS:
  1419.       GetSocketErrorDescription := 'Reference Count Overflow Failure';
  1420.     WSAETIMEDOUT:
  1421.       GetSocketErrorDescription := 'Connection Timeout Failure';
  1422.     WSAECONNREFUSED:
  1423.       GetSocketErrorDescription := 'Connection Refusal Failure';
  1424.     WSAELOOP:
  1425.       GetSocketErrorDescription := 'Symbolic Link Overflow Failure';
  1426.     WSAENAMETOOLONG:
  1427.       GetSocketErrorDescription := 'Invalid File Name Failure';
  1428.     WSAEHOSTDOWN:
  1429.       GetSocketErrorDescription := 'Host Down Failure';
  1430.     WSAEHOSTUNREACH:
  1431.       GetSocketErrorDescription := 'Host Unreachable Failure';
  1432.     WSAENOTEMPTY:
  1433.       GetSocketErrorDescription := 'Non-Empty Directory Removal Failure';
  1434.     WSAEPROCLIM:
  1435.       GetSocketErrorDescription := 'Process Overflow Failure';
  1436.     WSAEUSERS:
  1437.       GetSocketErrorDescription := 'Users Overflow Failure';
  1438.     WSAEDQUOT:
  1439.       GetSocketErrorDescription := 'Disk Quota Overflow Failure';
  1440.     WSAESTALE:
  1441.       GetSocketErrorDescription := 'Invalid File Handle Failure';
  1442.     WSAEREMOTE:
  1443.       GetSocketErrorDescription := 'File Path Overflow Failure';
  1444.     WSASYSNOTREADY:
  1445.       GetSocketErrorDescription := 'Unavailable Sub-Network Failure';
  1446.     WSAVERNOTSUPPORTED:
  1447.       GetSocketErrorDescription := 'Winsock Application Compatibility Failure';
  1448.     WSANOTINITIALISED:
  1449.       GetSocketErrorDescription := 'WinSock Uninitialized Failure';
  1450.     WSAHOST_NOT_FOUND:
  1451.       GetSocketErrorDescription := 'Host Not Located Failure';
  1452.     WSATRY_AGAIN:
  1453.       GetSocketErrorDescription := 'Non-Authority Host Not Located Failure';
  1454.     WSANO_RECOVERY:
  1455.       GetSocketErrorDescription := 'Fatal Winsock Error Failure';
  1456.     WSANO_DATA:
  1457.       GetSocketErrorDescription := 'Data Not Available Failure';
  1458.     else GetSocketErrorDescription := 'No Error';
  1459.   end;
  1460. end;
  1461.  
  1462. { Activate timeout procedure }
  1463. procedure TCCSocket.ActivateNonAsynchTimeout;
  1464. begin
  1465.   if FTimeoutValue > 0 then
  1466.     SetTimer( Handle , 10 , FTimeoutValue * 1000 , nil );
  1467. end;
  1468.  
  1469. { Deactivate timeout procedure }
  1470. procedure TCCSocket.DeactivateNonAsynchTimeout;
  1471. begin
  1472.   if FTimeoutValue > 0 then KillTimer( Handle , 10 );
  1473. end;
  1474.  
  1475. end.
  1476.